(in-package :lilu-config)

;;;;
;;;; Lilu config files
;;;;

;;;
;;; user directory
;;;

(defparameter *user-config-directory* (uiop:merge-pathnames* "~/.lilu/"))

(defun find-user-config-file (relative-pathname &optional error-p)
  (assert (uiop:relative-pathname-p relative-pathname))
  (let* ((pathname (uiop:merge-pathnames*
                    relative-pathname *user-config-directory*))
         (file (probe-file pathname)))
    (when (uiop/pathname:directory-pathname-p file)
      (setf file nil))
    (when (and error-p (not file))
      (and error-p (error "user config file (~A) not found" pathname)))
    file))

(defun find-user-config-files (relative-directory-pathname &optional error-p relative-p)
  (assert (uiop:relative-pathname-p relative-directory-pathname))
  (let* ((pathname (uiop:ensure-directory-pathname
                    (uiop:merge-pathnames* relative-directory-pathname
                                           *user-config-directory*)))
         (dir (probe-file pathname)))
    (unless (uiop/pathname:directory-pathname-p dir)
      (setf dir nil))
    (when (and error-p (not dir))
      (error "directory (~A) not found" relative-directory-pathname))
    (when dir
      (if relative-p
          (mapcar #'(lambda (p)
                      (uiop:merge-pathnames*
                       (uiop/pathname:enough-pathname p dir)
                       (uiop:ensure-directory-pathname relative-directory-pathname)))
                  (uiop/filesystem:directory-files dir))
          (uiop/filesystem:directory-files dir)))))

(defun create-user-config-file (relative-pathname &optional copy-from-pathname)
  (assert (uiop:relative-pathname-p relative-pathname))
  (flet ((create-empty-file (pathname)
           (with-open-file (strm pathname :direction :output
                                          :if-exists :supersede
                                          :if-does-not-exist :create))))
    (let ((dest (uiop:merge-pathnames* relative-pathname *user-config-directory*)))
      (uiop:ensure-all-directories-exist (list dest))
      (if copy-from-pathname
          (uiop:copy-file copy-from-pathname dest)
          (create-empty-file dest))
      dest)))

;;;
;;; system directories
;;;

(defvar *system-config-directories* nil)
(defparameter *system-config-relative-directory* #p"dot-lilu/")

(defun find-system-config-file (relative-pathname &optional error-p)
  (assert (uiop:relative-pathname-p relative-pathname))
  (or (find-if #'(lambda (file)
                   (and file
                        (not (uiop/pathname:directory-pathname-p file))))
               (mapcar #'(lambda (d)
                           (probe-file (uiop:merge-pathnames* relative-pathname d)))
                       *system-config-directories*))
      (and error-p
           (error "user system file (~A) not found (~{~A ~})" relative-pathname
                  *system-config-directories*))))

(defun find-system-config-files (relative-directory-pathname &optional error-p relative-p)
  (assert (uiop:relative-pathname-p relative-directory-pathname))
  (let ((relative-files))
    (dolist (sdir *system-config-directories*)
      (let* ((pathname (uiop:ensure-directory-pathname
                        (uiop:merge-pathnames* relative-directory-pathname sdir)))
             (dir (probe-file pathname)))
        (unless (uiop/pathname:directory-pathname-p dir)
          (setf dir nil))
        (when (and error-p (not dir))
          (error "directory (~A) not found" relative-directory-pathname))
        (when dir
           (setf relative-files
                (remove-duplicates (append
                                    (mapcar #'(lambda (p)
                                                (uiop:merge-pathnames*
                                                 (uiop/pathname:enough-pathname p dir)
                                                 (uiop:ensure-directory-pathname relative-directory-pathname)))
                                            (uiop/filesystem:directory-files dir))
                                    relative-files))))))
    (if relative-p
        relative-files
        (mapcar #'find-system-config-file
                relative-files))))

(defun register-system-config-directories ()
  (setf *system-config-directories* nil)
  (dolist (system-name (asdf:registered-systems))
    (multiple-value-bind (foundp found-system pathname previous previous-time)
        (asdf:locate-system system-name)
      (declare (ignore foundp found-system pathname previous-time))
      (let ((pathname (asdf:component-pathname previous)))
        (when pathname
          (let ((p (uiop:merge-pathnames* *system-config-relative-directory*
                                          pathname)))
            (when (probe-file p)
              (unless (member p *system-config-directories* :test #'equal)
                (push p *system-config-directories*))))))))
  *system-config-directories*)

;;;
;;; both
;;;

(defun find-config-file (relative-pathname &optional error-p)
  (assert (uiop:relative-pathname-p relative-pathname))
  (let ((file
          (or
           (find-user-config-file relative-pathname nil)
           (find-system-config-file relative-pathname nil))))
    (when (and (not file) error-p)
      (error "config file (~A) not found (~{~A ~})" relative-pathname
             (cons *user-config-directory*
                   *system-config-directories*)))
    file))

(defun ensure-config-file (relative-pathname &optional force-user-p)
  (assert  (uiop:relative-pathname-p relative-pathname))
  (or
   (if force-user-p
       (find-user-config-file relative-pathname)
       (find-config-file relative-pathname))
   (create-user-config-file relative-pathname (find-system-config-file relative-pathname))))

(defun find-config-files (relative-pathname &optional error-p relative-p)
  (declare (ignore error-p))
  (assert (uiop:relative-pathname-p relative-pathname))
  (let ((relative-files
          (remove-duplicates
           (append (find-user-config-files relative-pathname nil t)
                   (find-system-config-files relative-pathname nil t)))))
    (if relative-p
        relative-files
        (mapcar #'find-config-file
                relative-files))))
